TeX 1995 July/TeX CD-ROM July 1995 (Disc 1)(Walnut Creek)(1995).ISO/macros/text1/macintosh/texix.turbomac

Text File | 1991-10-23 | 14KB | 592 lines

% Version 1.0; Dean Guenther; 4/1/86
% Version 1.1; Dean Guenther; 12/87
% Version 1.2; Dean Guenther; 6/28/88
These are the changes necessary to use TEXIX with Turbo mac pascal.

@x   line 6
    \centerline{{\twelvept For IBM VM/CMS Pascal/VS}}
@y
    \centerline{{\twelvept For Macintosh Turbo Pascal}}
@z

@x   line 68
\def\PASCAL{{\sc PASCAL/VS}}
@y
\def\PASCAL{{\sc Macintosh Turbo Pascal}}
@z

@x   line 87
@ The @^TEXIX@>
program is written entirely in WEB, except for an external
procedure, {\it plsort}, which is written in @^PL/1@> PL/1.
This was necessary since
\PASCAL\  cannot call
@:plsort@>
Syncsort @^SYNCSORT@>
to do an internal sort, and PL/1 can.
@y
@ The @^TEXIX@>
program is written entirely in WEB, except for an internal
sort which uses the TURBO Pascal DataBase Toolbox sort.
This was necessary since
\PASCAL\  cannot itself do a sort.
@z

@x   line 107
segment texix;
procedure texix(ix:char); external;
procedure texix;
@y
program texix;
@{$U Sort@}
uses sane, MemTypes, QuickDraw, OSIntf, Sort, toolintf; @/
@{It is required to convert all @@ into a shift-6 \^ {} before
compiling this with turbo pascal@}  @{ There is one exception,
the line at the bottom that calls the Sort routine should retain
the at signs.@}

@z

@x   line 119
@<Global Var...@>=
sysprint:text;
@!ix_file :text;
@y
@<Global Var...@>=
sysprint:text;
@!ix_file :text;
@!curslist:CursorList;
@!total_recs:integer;
@!clock_time:integer;
@z

@x   line 123
@ The {\it sort\_file} is used for the internal sort only. The \text1\  user
never has access to it.

@<Global Var...@>=
@!sort_file :file of sort_type;
@y
@ The {\it sort\_file} used with Pascal/VS is not needed in \PASCAL.
@z

@x   line 136
@d dosubstr == substr
@d doindex == index
@y
@d dosubstr == copy
@d doindex == getindex
@z

@x   line 142
@d getout == return
@d messages == sysprint
@y
@d getout == exit
@d messages == output
@z

@x   line 147
@d max_field = 300
@d max_levels = 3
@d max_lrecl = 2048
@y
@d max_field = 255
@d max_levels = 3
@d max_lrecl = 255
@z

@x   line 147
in_record := dosubstr(in_record,1 + #)
@y
in_record := dosubstr(in_record,1 + #,length(in_record))
@z

@x   line 160
@d string_type(#) == string(#)
@y
@d string_type(#) == string[#]
@z

@x   line 206
@ This is arbitrary, but
there should never be more than 8 indicies.

@d s_file_number == '9'
@y
@ The variable {\it s\_file\_number} is not used in  \PASCAL\ and
is omitted here.
@z

@x   line 253
  ccat := x ccat_temp y;
@y
  ccat := concat(x,y);
@z

@x   line 277
@p procedure reset_file(file_number:char);
begin
if file_number = '9' then reset(sort_file,
'NAME=TEXT1$$.OUTSORT.A,LRECL=1857,RECFM=V')
else reset(ix_file,
ccat(ccat('NAME=TEXT1$$.IX',str(file_number)),'.A'));
end;
@y
@p procedure reset_file(file_number:char);
begin
@{$I-@}
reset(ix_file,
ccat('TEXT1$$.IX',file_number));
@{$I+@}
if ioresult <> 0 then
begin
writeln(messages,^G,
' -- Cannot find file ',ccat('TEXT1$$.IX',file_number));
halt;
end;
end;

function getindex(x:string_pass;y:string_pass):integer;
begin
   getindex := pos(y,x);
   end;

function trim(object:string_pass):string_pass;
var i:integer;
new_string:string_pass;
begin
i:=length(object)+1;
repeat
  decr(i);
  until (object[i] <> ' ') or (i=1);
if (object[i] = ' ') and (i=1)
then new_string:=''
else new_string:=copy(object,1,i);
trim:=new_string;
end;
@z

@x   line 292
@p procedure file_rewrite(file_number:char);
begin
if file_number = '9'
then
rewrite(sort_file,'NAME=TEXT1$$.INSORT.A,LRECL=1857,RECFM=V')
else
rewrite(ix_file,
ccat(ccat('NAME=TEXT1$$.IX',str(file_number)),
'.A,LRECL=2048,RECFM=V'));
end;
@y
@p procedure file_rewrite(file_number:char);
begin
rewrite(ix_file,
ccat('TEXT1$$.IX',file_number));
end;
@z

@x   line 343
@ @<Global Types@>=
@!string_pass=string_type(max_lrecl);
@y
@ @<Global Types@>=
@!CursorList    = array[iBeamCursor..watchCursor] of CursHandle;
@!string_pass=string_type(max_lrecl);
@z

@x   line 444
@ The {\it get\_numeric}
function will take a packed array of length max\_pn\_alpha and convert
that array (which is really the page number) into an integer.

@p function get_numeric(x_string:string_type(max_pn_alpha)):integer;
var @!i:integer;
begin
readstr(x_string,i);
get_numeric:=i;
end;
@y
@ This function is needed to put the string to be converted by
get\_numeric into the upper right portion of the string to be
converted.

@p function shift_right(in_string:string_pass):decstr;
var i,j:integer; temp:pn_alpha_type;
begin
  j:=0;
  repeat incr(j); {find the first blank}
   until (in_string[j] = ' ') or (in_string[j] = '') or
         (j >= length(in_string));
  for i:= 1 to sizeof(temp)-1 do temp[i]:=' ';
  for i:=1 to j do temp[sizeof(temp)-j+i]:=in_string[i];
  shift_right:=temp;
  end;

@ The {\it get\_numeric}
function will take a packed array of length max\_pn\_alpha and convert
that array (which is really the page number) into an integer.

@p function get_numeric(x_string:string_pass):integer;
var @!i:integer;
begin
get_numeric:=num2integer(str2num(shift_right(x_string)));
end;
@z

@x   line 459
@p procedure strvalue(x:integer; var results:pass_pn_alpha);
var
temp:string_type(max_pn_alpha);
begin
writestr(temp,x);
results:=ltrim(temp);
end;
@y
@p procedure strvalue(X:integer; var results:pass_pn_alpha);
var temp:decstr;
    y:extended;
    f:decform;
    i,qq:integer;
begin
  f.style := fixeddecimal;
  f.digits:=0;
  y:=num2extended(x);
  for i := 1 to decstrlen do temp[i] := ' ';
  num2str(f,y,temp);
  i:=1;
  results:=temp;
  end;
@z

@x   line 470
@p function strconv(x:pn_alpha_type):string_type(max_pn_alpha);
var i:integer;
temp:string_type(max_pn_alpha);
begin
temp:='';i := 1;
with sort_record do begin
repeat
if x[i] <> ' ' then
temp := ccat(temp,str(x[i]));
incr(i);
until (i > max_pn_alpha) or (x[i] = ' ');
end;
strconv:=temp;
end;
@y
@p function strconv(x:pn_alpha_type):pass_pn_alpha;
var i:integer;
temp:string_type(max_pn_alpha);
begin
temp:='';i := 1;
with sort_record do begin
repeat
if x[i] <> ' ' then
temp := ccat(temp,x[i]);
incr(i);
until (i > max_pn_alpha) or (x[i] = ' ');
end;
strconv:=temp;
end;
@z

@x   line 626
@ The {\it plsort} procedure is written in PL/1 to call the CMS sort program
Syncsort. This was necessary since you cannot call Syncsort from PASCAL/VS.
The fields to be sorted are defined internally in the {\it plsort}
program. This should be the same as the three sort fields in {\it sort\_type}.
@:sort_type@>
@:plsort@> @^PL/1@>
@^Syncsort@>

@p procedure plsort(var sort_rc:integer); fortran;
@y
@ The {\it LessRec} function is used by Turbo Pascal Database Toolbox's
Sort routine. It returns true if record ``x'' is less than record ``y''.
The record {\it sort\_type} is used for comparison.
@:sort_type@>

@p function  LessRec(var x,y :sort_type):boolean;
var Lower :boolean;
begin Lower := (x.sort_part[1].field_level < y.sort_part[1].field_level);
if not Lower then begin {x $\ge$ y}
Lower := (x.sort_part[1].field_level =  y.sort_part[1].field_level);
if Lower then begin {x = y}
Lower := (x.sort_part[2].field_level < y.sort_part[2].field_level);
if not Lower then begin {x $\ge$ y}
Lower := (x.sort_part[2].field_level =  y.sort_part[2].field_level);
if Lower then begin {x = y}
Lower := (x.sort_part[3].field_level < y.sort_part[3].field_level);
if not Lower then begin {x $\ge$ y}
Lower := (x.sort_part[3].field_level =  y.sort_part[3].field_level);
if Lower then begin {x = y}
Lower := (x.abs_page_number < y.abs_page_number);
if not Lower then begin {x $\ge$ y}
Lower := (x.abs_page_number =  y.abs_page_number);
if Lower then begin {x = y}
Lower := (x.page_number < y.page_number);
if not Lower then begin {x $\ge$ y}
Lower := (x.page_number = y.page_number);
if Lower then {x = y}
Lower := (x.record_type < y.record_type);
end; end; end; end; end; end; end; end; end;
LessRec := Lower;
end;
@z

@x   line 643
@ This function converts to all uppercase.
Notice that this is an EBCIDIC conversion, not an ASCII conversion
to uppercase.

@p function upper_case(x:char):char;
var temp:char;
begin
  if (ord(x)>=129)and(ord(x)<=169) then
      temp:=chr(ord(x)+64)
  else temp:=x;
upper_case:=temp;
end;
@y
@ This function converts to all uppercase.
Notice that this is an ASCII   conversion, not an EBCDIC  conversion
to uppercase.

@p function upper_case(x:char):char;
var temp:char;
begin
  if ord(x) >= "a" then
      temp:=chr(ord(x)-@'40)
  else temp:=x;
upper_case:=temp;
end;
@z

@x   line 719
@<Get Default Index Values@>
@y
writeln(messages);
writeln(messages,'Reading in the input now...');
total_recs := 0;
@<Get Default Index Values@>
@z

@x   line 722
@<Read Next Record@>@/
@y
@<Read Next Record@>@/
incr(total_recs);write(total_recs:6);gotoxy(1,6);
@z

@x   line 728
end;end;
@y
end;
close(ix_file);
writeln(messages);
writeln(messages,'done reading the records. Starting to sort......');
clock_time := tickcount;
end;
@z

@x   line 738
if dosubstr(in_record,doindex(in_record,'=')+1) = 'no'
@y
if dosubstr(in_record,doindex(in_record,'=')+1,length(in_record))
  = 'no'
@z

@x   line 744
if dosubstr(in_record,doindex(in_record,'=')+1) = 'no'
@y
if dosubstr(in_record,doindex(in_record,'=')+1,length(in_record))
  = 'no'
@z

@x   line 867
@ Ok, the record has been processed, so write it to the output file.

@<Write Sort Record@>=
sort_file@@:=sort_record;
put(sort_file);
@y
@ Ok, the record has been processed, so write it to the output file
using the procedure defined to Turbo Pascal's Database Toolbox.

@<Write Sort Record@>=
SortRelease(sort_record);
@z

@x   line 890
The page number for a blind entry will always be 999999999.

@<Do Blind Entry@>=
begin remove_characters(6);{Throw away the `\$\{\$\}be'}@/
i := doindex(in_record,'{$}');
curr_level:=2;
write_print_chars(i-1);
curr_level:=0;
remove_characters(3);{Throw away the `\{\$\}'}
sort_record.page_number := 999999999;
@y
The page number for a blind entry will always be 9999.

@<Do Blind Entry@>=
begin remove_characters(6);{Throw away the `\$\{\$\}be'}@/
i := doindex(in_record,'{$}');
curr_level:=2;
write_print_chars(i-1);
curr_level:=0;
remove_characters(3);{Throw away the `\{\$\}'}
sort_record.page_number := 9999;
@z

@x   line 976
str_blind_entry := ccat(str_blind_entry,str(field_level[i]));
@y
str_blind_entry := ccat(str_blind_entry,field_level[i]);
@z

@x   line 996
@ If the {\it page\_string[1]} is less than zero, its alphabetic and
roman numeral processing is necessary.

@<Do Sorted Non Blind Entry@>=
with sort_record do begin
if ord(page_string[1]) < ord('0')
@y
@ If the {\it page\_string[1]} is greater
 than nine, its alphabetic and
roman numeral processing is necessary.

@<Do Sorted Non Blind Entry@>=
with sort_record do begin
if ord(page_string[1]) > ord('9')
@z

@x   line 1103
then curr_str_page:=dosubstr(curr_str_page,2)
@y
then curr_str_page:=dosubstr(curr_str_page,2,length(curr_str_page))
@z

@x   line 1182
str_build := dosubstr(str_build,i+1);
end;
@<Get the Current Print Type of this Page Number@>;@/
if ord(curr_str_page[1]) < ord('0') {Then its alphabetic}
@y
str_build := dosubstr(str_build,i+1,length(str_build));
end;
@<Get the Current Print Type of this Page Number@>;@/
if ord(curr_str_page[1]) > ord('9') {Then its alphabetic}
@z

@x   line 1195
str_build := dosubstr(str_build,i+1);
@y
str_build := dosubstr(str_build,i+1,length(str_build));
@z

@x   line 1311
while not eof(sort_file) do begin
sort_record:=sort_file@@;
get(sort_file);
@y
file_rewrite(ix);
clock_time := tickcount - clock_time;write(^G);
writeln(messages,'It took ',clock_time/60.0:1:4,' seconds to sort ',
total_recs:6,' records.');
writeln(messages,'Now building the file to be formated with TEXT1...');
while not SortEOS        do begin
SortReturn(sort_record);
@z

@x   line 1524
@* Main Program.
Ok, here is the main program. First we initialize (all\_blanks); then
set the ix\_file for input and the sort\_file for output; read all of the
entries, processing each one; close the files; sort; read the sorted file
in and build the entries, writing them back to the ix\_file to be read in
by the index markup. WHEW!!

@p
begin @<Initialize Main@>@/
termout(messages);
reset_file(ix);@/
file_rewrite(s_file_number); {Should always be file 9}@/
read_all_entries;@/
close(ix_file);@/
close(sort_file);@/
@<Sort the Index@>@/
reset_file(s_file_number);@/
file_rewrite(ix);@/
build_sorted_index;@/
end;
@y
@* Main Program.
Ok, here is the main program. First we initialize (all\_blanks); then
prompt to determine which index to use (1, 2, or 3).
Next call Turbo Pascal's sort routine. And thats it.
 WHEW!!

@p
begin @<Initialize Main@>@/
write('Which index are you processing (1, 2, or 3)? ');@/
readln(ix);@/
if (ix <> '1') and (ix <> '2') and (ix <> '3') then begin
writeln(messages,
'You can only process indexes 1, 2, or 3. Start again.');
halt; end;
clearscreen;writeln('');
writeln(messages,'Loading the sort routine....');
writeln(messages);
reset_file(ix);@/
for m := iBeamCursor to watchCursor do begin
curslist[m] := getcursor(m);
hlock(handle(curslist[m]));end;setcursor(curslist[watchCursor]^^);
showcursor;
@<Sort the Index@>@/
hidecursor;
close(ix_file); {ix_file now has the index to be run through \TeX}
write(messages,'Press any key to continue ');readln;
end.
@z


@x   line 1548
@ As mentioned earlier, {\it plsort} is an external PL/1 subroutine
@^PL/1@>
@^Syncsort@>
which is used to call Syncsort to sort the file.
The sort fields are as follows:
@y
@ As mentioned earlier, {\it TurboSort} is a Turbo Toolbox Database
 subroutine
which is used to sort the index file.
The sort fields are as follows:
@z

@x   line 1562
sort_rc:integer;
@y
sort_rc:integer;
@!ix:char;
@z

@x   line 1564
@ @<Sort the Index@>=
plsort(sort_rc);
if sort_rc = 0
   then writeln(messages,'Index Successfully Completed')
   else writeln(messages,'Index Failed');
@y
@ @<Sort the Index@>=
sort_rc := TurboSort(sizeof(sort_type),@@read_all_entries,
@@LessRec, @@build_sorted_index);
if sort_rc = 0
   then writeln(messages,'Index Successfully Completed')
   else writeln(messages,'Index Failed');
@z